home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / disk / cluster2.zip / SOURCE.ZIP / BOXMGR.BU next >
Text File  |  1996-07-06  |  26KB  |  584 lines
  1. $COMPILE UNIT ".\BOXMGR.PBU"
  2. $CODE SEG "SCRNLIB"
  3. $CPU      8086      ' Make compatible with XT systems
  4. $LIB      ALL OFF   ' Turn off all PowerBASIC libraries
  5. $ERROR    ALL OFF   ' Turn off all PowerBASIC error checking
  6. $OPTIMIZE SIZE      ' Optimize for smaller code
  7.  
  8. DEFINT    A-Z       ' Required for all numeric functions, forces PB to not
  9.                     ' include floating point in UNIT (makes it smaller)
  10.  
  11. '╒═══════════════════════════════════════════════════════════════════════════╕
  12. '│  This library will manage boxes, saving and restoring the                 │
  13. '│  underlying screen areas as needed.  It also has some other               │
  14. '│  handy routines, such as a scrolling text viewer, a routine               │
  15. '│  to set PowerBASIC's PRINT output to only be in the current box           │
  16. '│                                                                           │
  17. '│  This code is free for use, but is copyright Nathan C. Durland III        │
  18. '│  All rights reserved                                                      │
  19. '╞═══════════════════════════════════════════════════════════════════════════╡
  20. '│ Started Jun 10, 1996  --  Bud Durland                                     │
  21. '╞═══════════════════════════════════════════════════════════════════════════╡
  22. '│ Routines are documented with liberal comments in the routine itself       │                                                                  │
  23. '│                                                                           │
  24. '│ However, a quick overview:                                                │
  25. '│                                                                           │
  26. '│ This routine will simplify creating and using screen text boxes.          │
  27. '│ Each of the routines is pretty well commented and should be               │
  28. '│ self-explainatory.  Let me touch a couple of the highlights:              │
  29. '│                                                                           │
  30. '│  1)  always remember to call BoxInit before using any of hte other        │
  31. '│      functions listed here.  This routine sets up storage arrays          │
  32. '│      and etc.                                                             │
  33. '│                                                                           │
  34. '│  2)  To specify colors, you will be passing the routines attribute        │
  35. '│      values, which are a computed using the numeric value of the          │
  36. '│      foreground and background colors you want.  the                      │
  37. '│      MakeAttr%(Fore%,Back%) function will compute attributes for          │
  38. '│      you.  Likewise, the PB3BOXES.INC file has pre-defined                │
  39. '│      constants for most of the colors.  So, you can do something          │
  40. '│      like Box1Attr% = MakeAttr%(%BrightWhite,%Blue)                       │
  41. '│                                                                           │
  42. '│  3)  If you use -1 instead of an attribute value in PrtBox, PrtEOL,       │
  43. '│      ClearBox, or BoxTiltle, the default color attribute specified        │
  44. '│      when the box was created will be used.                               │
  45. '│                                                                           │
  46. '╘═══════════════════════════════════════════════════════════════════════════╛
  47.  
  48. DECLARE SUB GetStrLoc()     ' internal string locator in RTL
  49.  
  50. $INCLUDE ".\PB3BOXES.HDR"      ' includes defs & declares for all modules.
  51.  
  52.  
  53. SUB BoxInit(BYVAL MB%) LOCAL PUBLIC
  54. '╒═══════════════════════════════════════════════════════════════════════╕
  55. '│This sub initializes the arrays used to store window data              │
  56. '│                                                                       │
  57. '│ MB% is the the maximum numberof boxes you will be using.  5 is the    │
  58. '│ default                                                               │
  59. '│                                                                       │
  60. '╘═══════════════════════════════════════════════════════════════════════╛
  61.     CurrentBox% = 0
  62.     MaxBoxes% = MB%
  63.   IF MaxBoxes% < 1 THEN MaxBoxes% = 5
  64.  
  65.     DIM BoxParms%(1:MaxBoxes%,1:6)        ' stores Size, Color, & border type
  66.   DIM SaveText$(1:MaxBoxes%)            ' stores saved text
  67.     DIM BorderText$(0:3)                  ' Different box borders
  68.  
  69.   BorderText$(0) = CHR$( 32, 32, 32, 32, 32, 32)  ' no border
  70.   BorderText$(1) = CHR$(196,179,218,191,192,217)  ' single
  71.   BorderText$(2) = CHR$(205,186,201,187,200,188)  ' double
  72.   BorderText$(3) = CHR$(219,219,219,219,219,219)  ' Solid
  73.  
  74. END SUB
  75.  
  76. SUB MakeBox(BYVAL Row%, BYVAL Col%, BYVAL Rows%, BYVAL Cols%, _
  77.             BYVAL BoxAttr%, BYVAL Border%) LOCAL PUBLIC
  78. '╒══════════════════════════════════════════════════════════════════════════╕
  79. '│ MAKEBOX -- put a box on the screen.  underlying text is preserved        │
  80. '│            so it can be put back by the RemoveBox routine                │
  81. '│                                                                          │
  82. '│Row%  =  Top row of box                                                   │
  83. '│Col%  =  Left column                                                      │
  84. '│Rows% =  length of box                                                    │
  85. '│Cols% =  Width of box                                                     │
  86. '│BoxAttr%  =  color attribute for box                                      │
  87. '│Border%   =  border style to use 0-None 1-single 2-double 3-Solid         │
  88. '│             Add 10 to value for "3-d" border                             │
  89. '╘══════════════════════════════════════════════════════════════════════════╛
  90.   IF CurrentBox% = MaxBoxes% THEN EXIT SUB    ' no more room for making boxes.
  91.   IF Border% < 0 THEN Border% = 1
  92.  
  93.   INCR CurrentBox%,1                          ' bump box number
  94.   BoxParms%(CurrentBox%,1) = Row%             ' Save infor about Box
  95.   BoxParms%(CurrentBox%,2) = Col%
  96.   BoxParms%(CurrentBox%,3) = Rows%
  97.   BoxParms%(CurrentBox%,4) = Cols%
  98.   BoxParms%(CurrentBox%,5) = BoxAttr%
  99.   BoxParms%(CurrentBox%,6) = Border% MOD 10
  100.   lAttr% = BoxAttr%
  101.  
  102. ' Get component colors of box attribute for use in 3d effects
  103.   IF Border% > 9 THEN
  104.     CALL ReturnAttr(BoxAttr%, TheFore%, TheBack%)
  105.     IF TheFore% = TheBack% THEN         ' caller wants same fore & back colors
  106.       LowFore% = TheFore%               ' Why?  Dunno, but we'll let it happen
  107.       HiFore% = TheFore%
  108.     ELSE
  109.       LowFore% = TheFore% MOD 8           ' low intesity colors are < 8
  110.       HiFore% = LowFore% + 8              ' high intensity is => 8
  111.     END IF
  112.     lAttr% = MakeAttr%(LowFore%,TheBack%)
  113.     hAttr% = MakeAttr%(HiFore%,TheBack%)
  114.   END IF
  115.  
  116. ' Save the underlying text, then create the box!
  117.   temp$ = ""
  118.   CALL QSAVE(Row%, Col%, Rows%, Cols%, temp$)
  119.   SaveText$(CurrentBox%) = temp$
  120.   CALL QBOX(Row%, Col%, Rows%, Cols%, lAttr%, (Border% MOD 10))
  121.  
  122.   IF Border% > 10 THEN
  123.     CALL QATTR((Row% + Rows%)-1,Col%,1,Cols%,hAttr%)
  124.     CALL QATTR(Row%+1,(Col%+Cols%)-1,Rows%-1,1,hAttr%)
  125.   END IF
  126.  
  127. END SUB
  128.  
  129. SUB RemoveBox LOCAL PUBLIC
  130. '╒═════════════════════════════════════════════════════════════════════╕
  131. '│ RemoveBox -- Takes a box off the screen, and replaces it with the   │
  132. '│              saved underlying data                                  │
  133. '╘═════════════════════════════════════════════════════════════════════╛
  134.   IF CurrentBox% < 1 THEN EXIT SUB
  135.  
  136.   Row%  = BoxParms%(CurrentBox%,1)
  137.   Col%  = BoxParms%(CurrentBox%,2)
  138.   Rows% = BoxParms%(CurrentBox%,3)
  139.   Cols% = BoxParms%(CurrentBox%,4)
  140.   temp$ = SaveText$(CurrentBox%)
  141.  
  142.   CALL QREST(Row%, Col%, Rows%, Cols%, temp$)
  143.  
  144.   DECR CurrentBox%
  145.  
  146. END SUB
  147.  
  148. SUB ClearBox(BYVAL Char%, BYVAL Attr%) LOCAL PUBLIC
  149. '╒════════════════════════════════════════════════════════════════════════════╕
  150. '│ Clears the current box using the specified character and attribute         │
  151. '╞════════════════════════════════════════════════════════════════════════════╡
  152. '│Char%  --  ASCII value of character to use.  If < 0, a space is used.       │
  153. '│Attr%  --  Color attribute to use.  if < 0, the default for the box is used │
  154. '╘════════════════════════════════════════════════════════════════════════════╛
  155.  
  156.   IF CurrentBox% = 0 THEN EXIT SUB
  157.  
  158.   IF Char% < 0 THEN Char% = 32
  159.   IF Attr% < 0 THEN Attr% = BoxParms%(CurrentBox%,5)
  160.  
  161.   Row% = BoxParms%(CurrentBox%,1)
  162.   Col% = BoxParms%(CurrentBox%,2)
  163.   Rows% = BoxParms%(CurrentBox%,3)
  164.   Cols% = BoxParms%(CurrentBox%,4)
  165.  
  166.   IF BoxParms%(CurrentBox%,6) > 0 THEN    ' account for border!
  167.     INCR Row%,1
  168.     INCR Col%,1
  169.     DECR Rows%,2
  170.     DECR Cols%,2
  171.   END IF
  172.  
  173.   IF (Rows% < 1) OR (Cols% < 1) THEN EXIT SUB
  174.   CALL QFILL(Row%,Col%,Rows%,Cols%,Char%,Attr%)
  175.  
  176. END SUB
  177.  
  178. SUB PrtBox(BYVAL Row%, BYVAL Col%, BYVAL TheText$, BYVAL Attr%) LOCAL PUBLIC
  179. '╒═══════════════════════════════════════════════════════════════════════╕
  180. '│PrtBox  --  prints the specified text in the current box               │
  181. '│            at the specified row & column.                             │
  182. '╞═══════════════════════════════════════════════════════════════════════╡
  183. '│Row, Col  = where to print;  relative to upper left corner             │
  184. '│            of the current box.  Row is required.  If Col = 0,         │
  185. '│            the text is centered on row                                │
  186. '│                                                                       │
  187. '│TheText$  = what to print.                                             │
  188. '│                                                                       │
  189. '│Attr      = the attribute to use.  If this is =-1, then the            │
  190. '│            default color for the current box is used.                 │
  191. '╘═══════════════════════════════════════════════════════════════════════╛
  192.   IF CurrentBox% = 0 THEN EXIT SUB                      ' no boxes on screen
  193.   IF Attr% = -1 THEN Attr% = BoxParms%(CurrentBox%,5)   ' use box color
  194.  
  195.   RealRow% = Row% + BoxParms%(CurrentBox%,1)              'compute row to use
  196.   IF BoxParms%(CurrentBox%, 6) = 0 THEN DECR RealRow%,1   'allow for no border
  197.  
  198.   IF Col% = 0 THEN                          ' We're centering the print
  199.     LeftCol% = BoxParms%(CurrentBox%,2)                     ' get left column
  200.     RightCol% = (LeftCol% + BoxParms%(CurrentBox%,4))       ' add the width
  201.     IF BoxParms%(CurrentBox%,6) > 0 THEN                    ' Adjust for border
  202.       INCR LeftCol%,1
  203.       DECR RightCol%,1
  204.     END IF
  205.     CALL QPRINTC(RealRow%, LeftCol%, RightCol%, TheText$, Attr%)
  206.   ELSE
  207.     RealCol% = ABS(Col%) + BoxParms%(CurrentBox%,2)
  208.     IF BoxParms%(CurrentBox%, 6) = 0 THEN DECR RealCol%,1
  209.     CALL QPRINT(RealRow%, RealCol%, TheText$, Attr%)
  210.   END IF
  211.  
  212. END SUB
  213.  
  214. SUB PrtEOL(BYVAL Row%, BYVAL Col%, BYVAL TheText$, BYVAL Attr%) LOCAL PUBLIC
  215. '╒════════════════════════════════════════════════════════════════════════╕
  216. '│This is the same as PrtBox, except that the specified row is erased     │
  217. '│before the text is printed.                                             │
  218. '╘════════════════════════════════════════════════════════════════════════╛
  219.   IF CurrentBox% = 0 THEN EXIT SUB                    ' no boxes on screen
  220.   Attr1% = BoxParms%(CurrentBox%,5)                   ' use box color
  221.   IF Col% < 0 THEN Col% = 1
  222.  
  223.   RealRow% = Row% + BoxParms%(CurrentBox%,1)          'compute row to use
  224.   RealCol% = Col% + BoxParms%(CurrentBox%,2)          'compute column
  225.   dLen% = BoxParms%(CurrentBox%,4) - (Col% + 1)       ' how many columns
  226.   IF BoxParms%(CurrentBox%, 6) = 0 THEN               ' allow for no border
  227.     DECR RealRow%,1
  228.     DECR RealCol%,1
  229.   ELSE
  230.     DECR dLen%,2
  231.   END IF
  232.  
  233.   a$ = SPACE$(dLen%)                                 ' make a string of blanks
  234.   CALL QPRINT(RealRow%, RealCol%, a$, Attr1%)        ' print it
  235.   CALL PrtBox(Row%, Col%, TheText$, Attr%)           ' put the text in the box
  236.  
  237. END SUB
  238.  
  239. SUB NukeBoxes(BYVAL StopMe%) LOCAL PUBLIC
  240. '╒══════════════════════════════════════════════════════════════════════╕
  241. '│ NukeBoxes --   Use this to remove multiple boxes at once.            │
  242. '╞══════════════════════════════════════════════════════════════════════╡
  243. '│StopMe%  --  Number of boxes to be remain on the screen               │
  244. '│                                                                      │
  245. '│i.e.  CALL NukeBoxes(1) removes all boxes except the first one        │
  246. '╘══════════════════════════════════════════════════════════════════════╛
  247.  
  248.   WHILE CurrentBox% > StopMe%
  249.     CALL RemoveBox
  250.   WEND
  251.  
  252. END SUB
  253.  
  254. SUB SetBoxColor(BYVAL TheBox%, BYVAL NewAttr%) LOCAL PUBLIC
  255. '╓─────────────────────────────────────────────────────────────────────────────╖
  256. '║ Sets a new default color for the specified box.                             ║
  257. '║ This routine does not recolor the box to the new attribute;  call           ║
  258. '║ ClearBox(-1,-1)                                                             ║
  259. '║                                                                             ║
  260. '║TheBox%  --  Number of box to be changed.  If = -1, the current box is used. ║
  261. '║NewAttr% --  New color to assign the box.                                    ║
  262. '╙─────────────────────────────────────────────────────────────────────────────╜
  263.  
  264.   IF TheBox% > MaxBoxes% THEN EXIT SUB
  265.   IF TheBox% < 1 THEN TheBox% = CurrentBox%
  266.   Boxparms%(TheBox%, 5) = NewAttr%
  267.  
  268. END SUB
  269.  
  270. SUB BoxTitle(BYVAL Where%, BYVAL Text$, BYVAL Attr%) LOCAL PUBLIC
  271. '╒═══════════════════════════════════════════════════════════════════════════╕
  272. '│ Puts a box in one of 6 locations.                                         │
  273. '│                                                                           │
  274. '│   ┌─1────2─────3─┐                                                        │
  275. '│   │              │                                                        │
  276. '│   │              │                                                        │
  277. '│   │              │                                                        │
  278. '│   └─4────5─────6─┘                                                        │
  279. '│                                                                           │
  280. '│   Where%    = WHich location to use                                       │
  281. '│   Text$     = The text of the title.                                      │
  282. '│   Attr%     = Attribute to use.  -1 = use the current box color           │
  283. '│                                                                           │
  284. '│ *****  If the box's border type is 0, title are not allowed!! ******      │
  285. '╘═══════════════════════════════════════════════════════════════════════════╛
  286. ' titles not allowed if box border type is 0 (no border)
  287.   IF BoxParms%(CurrentBox%,6) = 0 THEN EXIT SUB
  288.  
  289.     Row%  = BoxParms%(CurrentBox%,1)                    'find out where box is
  290.     Col%  = BoxParms%(CurrentBox%,2)                    ' on the screen
  291.     Rows% = BoxParms%(CurrentBox%,3)
  292.     Cols% = BoxParms%(CurrentBox%,4)
  293.   IF Attr% < 0 THEN Attr% = BoxParms%(CurrentBox%,5)  ' get the color to use
  294.     Border% = BoxParms%(CurrentBox%,6)                  ' find border type
  295.  
  296.   SELECT CASE Border%                                 ' set "brackets" around
  297.         CASE 0: Text$ = " " + Text$ + " "                 ' the title text
  298.     CASE 1: Text$ = "┤" + Text$ + "├"
  299.     CASE 2: Text$ = "╣" + Text$ + "╠"
  300.         CASE 3: Text$ = "▌" + Text$ + "▐"
  301.         CASE 4: Text$ = " " + Text$ + " "
  302.     END SELECT
  303.  
  304.   tLen% = LEN(Text$)
  305.     IF Where% > 3 THEN INCR Row%,(Rows%-1)              ' determine where to
  306.   SELECT CASE Where%                                  ' print the title text
  307.         CASE 1,4                                          ' left side of window
  308.           INCR Col%,1
  309.     CASE 2,5                                          ' center of window
  310.       Col% = (Col% + (Cols% \ 2)) - (tLen% \ 2)
  311.         CASE 3,6                                          ' right side of window
  312.           Col% = (Col% + Cols% - 1) - tlen%
  313.   END SELECT
  314.  
  315.   CALL QPRINT(Row%, Col%, Text$, Attr%)               ' print it!
  316.  
  317. END SUB
  318.  
  319. SUB ScrollBox(BYVAL Direction%, BYVAL HowMany%) LOCAL PUBLIC
  320. '╓──────────────────────────────────────────────────────────────────────╖
  321. '║ Scrolls the text in the box up or down some number of rows           ║
  322. '║                                                                      ║
  323. '║ Direction%  --  if < 1, scroll down.  if =>1, scroll up              ║
  324. '║ HowMany%    --  how many rows to scroll                              ║
  325. '╙──────────────────────────────────────────────────────────────────────╜
  326.   IF CurrentBox% = 0 THEN EXIT SUB
  327.   IF HowMany%    = 0 THEN EXIT SUB
  328.  
  329.   Row% = BoxParms%(CurrentBox%,1)
  330.   Col% = BoxParms%(CurrentBox%,2)
  331.   Rows% = BoxParms%(CurrentBox%,3)
  332.   Cols% = BoxParms%(CurrentBox%,4)
  333.   Attr% = Boxparms%(CurrentBox%,5)
  334.   IF BoxParms%(CurrentBox%,6) > 0 THEN    ' account for border!
  335.     INCR Row%,1
  336.     INCR Col%,1
  337.     DECR Rows%,2
  338.     DECR Cols%,2
  339.   END IF
  340.  
  341.   IF Direction% > 0 THEN
  342.     CALL ScrollUp(Row%, Col%, Rows%, Cols%, Attr%, HowMany%)
  343.   ELSE
  344.     CALL ScrollDown(Row%, Col%, Rows%, Cols%, Attr%, HowMany%)
  345.   END IF
  346.  
  347. END SUB
  348.  
  349. SUB SetViewText(BYVAL XOff%, BYVAL YOff%) LOCAL PUBLIC
  350. '╓───────────────────────────────────────────────────────────────────────╖
  351. '║  This sub will set the VIEW TEXT command so that the output from any  ║
  352. '║  PRINT commands will be placed in the current box.                    ║
  353. '║                                                                       ║
  354. '║  Xoff%  --  Column offset added to the text window                    ║
  355. '║  Yoff%  --  Row offset added to the text window                       ║
  356. '║                                                                       ║
  357. '║  NOTE:  Removing or creating a box does not change VIEW TEXT.         ║
  358. '║         You must call this routing to PRINT text to the current       ║
  359. '║         box                                                           ║
  360. '╙───────────────────────────────────────────────────────────────────────╜
  361.  
  362.   IF CurrentBox% < 1 THEN
  363.     VIEW TEXT (1,1) - (80,24)
  364.     EXIT SUB
  365.   END IF
  366.  
  367.     TheRow% = BoxParms%(CurrentBox%,1)
  368.     TheCol% = BoxParms%(CurrentBox%,2)
  369.     RowCnt% = BoxParms%(CurrentBox%,3)
  370.     ColCnt% = BoxParms%(CurrentBox%,4)
  371.     Attr%   = BoxParms%(CurrentBox%,5)
  372.     Border% = BoxParms%(CurrentBox%,6)
  373.  
  374.     Col1% = TheCol% + ColCnt% - 1
  375.     Row1% = TheRow% + RowCnt% - 1
  376.     IF Border% > 0 THEN
  377.         INCR TheRow%,1
  378.         DECR Row1%,1
  379.         INCR TheCol%,1
  380.         DECR Col1%,1
  381.     END IF
  382.  
  383.     TheRow% = TheRow% + YOff%
  384.     TheCol% = TheCol% + XOff%
  385.  
  386.     VIEW TEXT (TheCol%,TheRow%) - (Col1%,Row1%)
  387.     CALL ReturnAttr(Attr%, f%, b%)
  388.     COLOR f%, b%
  389.  
  390. END SUB
  391.  
  392. FUNCTION MsgBox$(BYVAL TheMsg$, BYVAL GoodKeys$, BYVAL Attr%) LOCAL PUBLIC
  393. '╒══════════════════════════════════════════════════════════════════════════╕
  394. '│  this function will display the given message on the screen, and will    │
  395. '│  wait for the user to press a key.  When called, TheMsg$ should contain  │
  396. '│  the lines of text to be displayed (up to {screen size - 2}).  Each      │
  397. '│  line  should be separated by a line feed -- CHR$(10)                    │
  398. '╞══════════════════════════════════════════════════════════════════════════╡
  399. '│ The variable GoodKeys$ is sent in with the keystrokes that are valid     │
  400. '│ All of those keys will be accepted.  If GoodKeys$ is null (""), then     │
  401. '│ any key will be accepted and returned                                    │
  402. '╘══════════════════════════════════════════════════════════════════════════╛
  403.  
  404.   TheMsg$ = RTRIM$(TheMsg$, ANY CHR$(10,13,32))
  405.   TheMsg$ = REMOVE$(TheMsg$, ANY CHR$(13))
  406.   GoodKeys$ = UCASE$(GoodKeys$)
  407.  
  408.   LinesNeeded% = TALLY(TheMsg$,CHR$(10)) + 1
  409.   REDIM MBox$(1:LinesNeeded%)
  410.   MaxWidth% = 0
  411.  
  412.   FOR x% = 1 TO LinesNeeded%                        ' extract lines to an array
  413.     a$ = EXTRACT$(TheMsg$,CHR$(10))                 ' get next one
  414.     IF LEN(a$) > MaxWidth% THEN MaxWidth% = LEN(a$) ' check width
  415.     MBox$(x%) = a$                                  ' remember it
  416.     IF x% <> LinesNeeded% THEN                      ' point past CHR$(10)
  417.       TheMsg$ = MID$(TheMsg$,LEN(a$)+2)
  418.     END IF
  419.   NEXT x%
  420.  
  421.   BoxLines% = LinesNeeded% + 2                      ' setup to draw box
  422.   BoxWidth% = MaxWidth% + 2
  423.   IF BoxLines% > PbvScrnRows THEN BoxLines% = pbvScrnRows
  424.   IF BoxWidth% > PbvScrnCols THEN BoxWidth% = pbvScrnCols
  425.   TopLine% = (pbvScrnRows - BoxLines%) / 3       ' Center the box
  426.   LeftCol% = (pbvScrnCols - BoxWidth%) / 2
  427.   IF TopLine% < 1 THEN TopLine% = 1
  428.  
  429.   CALL MakeBox(TopLine%, LeftCol%, BoxLines%, BoxWidth%, Attr%, 1)
  430.  
  431.   FOR x% = 1 TO LinesNeeded%
  432.     CALL PrtBox(x%,0,MBox$(x%),-1)
  433.   NEXT x%
  434.  
  435.   TheVal$ = ""
  436.   WHILE LEN(TheVal$) = 0
  437.     WHILE NOT INSTAT:WEND
  438.     TheVal$ = INKEY$
  439.     IF LEN(TheVal$) = 1 THEN TheVal$ = UCASE$(TheVal$)
  440.     IF LEN(GoodKeys$) > 0 THEN
  441.       IF INSTR(GoodKeys$, TheVal$) = 0 THEN TheVal$ = ""
  442.     END IF
  443.   WEND
  444.   MsgBox$ = TheVal$
  445.   CALL RemoveBox
  446.  
  447. END FUNCTION
  448.  
  449. FUNCTION MakeAttr%(Fore%, Back%) LOCAL PUBLIC
  450. '╒══════════════════════════════════════════════════════════════════════╕
  451. '│ Creates the value of an attribute byte using Fore% as the foreground │
  452. '│ color and Back% as the background color                              │
  453. '╘══════════════════════════════════════════════════════════════════════╛
  454.  
  455.     Backgr% = Back% MOD 16        ' No values higher than 16 allowed
  456.   Foregr% = Fore% MOD 16
  457.   temp% = (Backgr% * 16) + Foregr%
  458.     IF Fore% > 15 THEN INCR temp%, 128    ' User wanted das blinken lights
  459.   MakeAttr% = temp%
  460.  
  461. END FUNCTION
  462.  
  463. SUB ReturnAttr(BYVAL A%, Fore%, Back%) LOCAL PUBLIC
  464. '╒══════════════════════════════════════════════════════════════════════╕
  465. '│ basically the reverse of MakeAttr% -- this will break an attribute   │
  466. '│ value into it's component parts:                                     │
  467. '│                                                                      │
  468. '│  a% -- attribute value                                               │
  469. '│  Fore% -- Foreground color of attribute                              │
  470. '│  Back% -- background color of attribute                              │
  471. '│                                                                      │
  472. '╘══════════════════════════════════════════════════════════════════════╛
  473.  
  474.  IF A% < 128 THEN
  475.      Fore% =  A% MOD 16
  476.      Back% =  A% \ 16
  477.  ELSE
  478.      Fore% = ((A% - 128)  MOD 16)
  479.      Fore% = Fore% + 16
  480.      Back% = (A% - 128)\16
  481.  END IF
  482. END SUB
  483.  
  484. SUB ScrollList(BYVAL ItemCount%, ItemList$(), BYVAL CenterIt%) PUBLIC LOCAL
  485. '╒════════════════════════════════════════════════════════════════════╕
  486. '│ Creates a scrolling list of lines.  Useful for help screens        │
  487. '│ You have to create a box first!                                    │
  488. '│                                                                    │
  489. '│   ItemCount%  = How many items there are in the list               │
  490. '│   ItemList$() = the items to be displayed.                         │
  491. '│   Centerit%   = If non-zero, the items will be centered in the box │
  492. '╘════════════════════════════════════════════════════════════════════╛
  493.  
  494.   IF CenterIt% THEN CCol% = 0 ELSE CCol% = 1
  495.   IF BoxParms%(CurrentBox%,6) > 0 THEN
  496.     WindowLines%  = BoxParms%(CurrentBox%,3) - 3
  497.     WindowCenter% = (BoxParms%(CurrentBox%,4) - 2) \ 2
  498.   ELSE
  499.     WindowLines%  = BoxParms%(CurrentBox%,3) - 1
  500.     WindowCenter% = (BoxParms%(CurrentBox%,4)) \ 2
  501.   END IF
  502.   TopPointer% = 1
  503.   DispTerm% = %False
  504.   WHILE NOT DispTerm%
  505.     Lptr% = 1
  506.     CALL ClearBox(-1,-1)
  507.     IF TopPointer% < 1 THEN TopPointer% = 1
  508.     FOR x% = TopPointer% to (TopPointer% + WindowLines%)
  509.       IF x% <= ItemCount% THEN
  510.         TheLine$ = ItemList$(x%)
  511.         CALL PrtBox(LPtr%,CCol%,TheLine$,-1)
  512.         INCR Lptr%,1
  513.       END IF
  514.     NEXT x%
  515. ' Now wait for the user to tell us to do something
  516.     AKey$ = Null$
  517.     WHILE LEN(AKey$) = 0
  518.       IF (TopPointer% > 1) AND (TopPointer% < (ItemCount% - WindowLines%)) THEN
  519.         fs$ = CHR$(0,18)  ' dbl head arrow
  520.       ELSEIF TopPointer% > 1 THEN
  521.         fs$ = CHR$(0,24) ' up arrow
  522.       ELSEIF TopPointer% < (ItemCount% - WindowLines%) THEN
  523.         fs$ = CHR$(0,25) ' down arrow
  524.       END IF
  525.       CALL BoxTitle(6,fs$,-1)
  526.       WHILE NOT INSTAT:WEND
  527.       AKey$ = INKEY$
  528.       IF LEN(AKey$) = 1 THEN AKey$ = UCASE$(AKey$)
  529.       SELECT CASE AKey$
  530.  
  531.                 CASE CHR$(27)
  532.                     CALL ClearBox(-1,-1)
  533.                     CALL BoxTitle(6,CHR$(0),-1)
  534.                     EXIT SUB
  535.  
  536.         CASE CHR$(0,73) ' PgUp
  537.           IF TopPointer% > 1 THEN
  538.             DECR TopPointer%,WindowLines%
  539.           ELSE
  540.             AKey$ = Null$
  541.           END IF
  542.  
  543.         CASE CHR$(0,81) ' PgDn
  544.           IF TopPointer% < (ItemCount% - WindowLines%) THEN
  545.             INCR TopPointer%,WindowLines%
  546.           ELSE
  547.             AKey$ = Null$
  548.           END IF
  549.  
  550.         CASE CHR$(0,71) ' HOME key
  551.           TopPointer% = 1
  552.  
  553.         CASE CHR$(0,79) 'END key
  554.           TopPointer% = ItemCount% - WindowLines%
  555.  
  556.         CASE CHR$(0,72) ' Up Arrow
  557.           IF TopPointer% > 1 THEN
  558.             CALL ScrollBox(0,1)
  559.             DECR TopPointer%,1
  560.             TheLine$ = ItemList$(TopPointer%)
  561.             TheLine$ = REMOVE$(TheLine$, ANY CHR$(1,2))
  562.             CALL PrtBox(1,CCol%,TheLine$,-1)
  563.           END IF
  564.           AKey$ = Null$
  565.  
  566.         CASE CHR$(0,80) 'Down arrow
  567.           IF TopPointer% < (ItemCount% - WindowLines%) THEN
  568.             CALL ScrollBox(1,1)
  569.             INCR TopPointer%,1
  570.             TheLine$ = ItemList$(TopPointer% + WindowLines%)
  571.             TheLine$ = REMOVE$(TheLine$, ANY CHR$(1,2))
  572.             CALL PrtBox(WindowLines% + 1,CCol%,TheLine$,-1)
  573.           END IF
  574.           AKey$ = Null$
  575.  
  576.         CASE ELSE
  577.           AKey$ = Null$
  578.       END SELECT
  579.     WEND 'AKey$
  580.   WEND 'NOT  DispTerm
  581.  
  582. END SUB
  583.  
  584.